home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / EAGUI / EAFrames.mod < prev    next >
Text File  |  1995-06-29  |  7KB  |  212 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: EAFrames.mod $
  4.   Description: Bordered frame for EAGUI.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.2 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:20:15 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18. <*$ StackChk- *>
  19. <*$ LongVars+ *>
  20.  
  21. MODULE EAFrames;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, s := Sets, e := Exec, u := Utility,
  25.   gfx := Graphics, i := Intuition, gt := GadTools, ea := EAGUI;
  26.  
  27. CONST
  28.  
  29.   (* Border rendering flags. *)
  30.  
  31.   DoubleBorder* = 0; (* Render a double border like the string gadget
  32.                       * border, otherwise use a BevelBox.
  33.                       *)
  34.   Recessed*     = 1; (* Draw a recessed border, otherwise draw a raised
  35.                       * one.
  36.                       *)
  37.   InnerBorder*  = 2; (* Draw the border around the inner edge of the border
  38.                       * zone, otherwise around the outer edge.
  39.                       *)
  40.  
  41. TYPE
  42.  
  43. (* Information that is needed by this object, but that isn't maintained
  44.  * by EAGUI itself.
  45.  *)
  46.  
  47.   FramePtr * = POINTER [2] TO Frame;
  48.   Frame * = RECORD [2]
  49.     flags *      : s.SET32;         (* different flags *)
  50.     shinePen *,
  51.     shadowPen *  : e.UBYTE;         (* pens to use *)
  52.     visInfo *    : gt.VisualInfo;   (* for drawing BevelBox *)
  53.   END;
  54.  
  55. VAR
  56.  
  57.   RenderHook * : u.HookPtr;
  58.   rhook : u.Hook;
  59.  
  60.  
  61. (*************************************************************************
  62. *                                                                        *
  63. * Render Method                                                          *
  64. *                                                                        *
  65. *************************************************************************)
  66.  
  67. PROCEDURE Render*
  68.   ( hook : u.HookPtr;
  69.     obj  : ea.OPTR;
  70.     rm   : ea.RenderMessagePtr )
  71.   : e.ULONG;
  72.  
  73.   VAR
  74.     frm : FramePtr;
  75.     width, height, left, top, bl, br, bt, bb, ignore : e.ULONG;
  76.     l, t, w, h : e.UWORD;
  77.     pen1, pen2 : e.UBYTE;
  78.     group : ea.OPTR;
  79.     tag : u.TagID; data : u.Tag;
  80.  
  81.   BEGIN (* Render *)
  82.     (* get a pointer to our structure, and check if we actually got it *)
  83.     frm := SYS.VAL (FramePtr, ea.GetAttr (obj, ea.UserData));
  84.     IF frm # NIL THEN
  85.       (* get the container object *)
  86.       group := SYS.VAL (ea.OPTR, ea.GetAttr (obj, ea.Parent));
  87.       ASSERT (group # NIL, 96);
  88.  
  89.       (* get sizes of the object *)
  90.       ignore := ea.GetAttrs ( group,
  91.                               ea.Width,     SYS.ADR (width),
  92.                               ea.Height,    SYS.ADR (height),
  93.                               u.done );
  94.  
  95.       (* get offsets of object relative to root (window) *)
  96.       left := ea.GetObjectLeft (rm.root_ptr, group);
  97.       top := ea.GetObjectTop (rm.root_ptr, group);
  98.  
  99.       IF ~(InnerBorder IN frm.flags) THEN
  100.         ignore := ea.GetAttrs ( group,
  101.                                 ea.BorderLeft,   SYS.ADR (bl),
  102.                                 ea.BorderRight,  SYS.ADR (br),
  103.                                 ea.BorderTop,    SYS.ADR (bt),
  104.                                 ea.BorderBottom, SYS.ADR (bb),
  105.                                 u.done );
  106.         DEC (left, bl); DEC (top, bt);
  107.         INC (width, bl + br); INC (height, bt + bb)
  108.       END;
  109.  
  110.       IF DoubleBorder IN frm.flags THEN
  111.         IF Recessed IN frm.flags THEN
  112.           pen1 := frm.shadowPen; pen2 := frm.shinePen
  113.         ELSE
  114.           pen2 := frm.shadowPen; pen1 := frm.shinePen
  115.         END;
  116.         l := SHORT (left); t := SHORT (top);
  117.         w := SHORT (width); h := SHORT (height);
  118.         gfx.Move (rm.rastport_ptr, l, t);
  119.         gfx.SetAPen (rm.rastport_ptr, pen1);
  120.         gfx.Draw (rm.rastport_ptr, l + w - 1, t);
  121.         gfx.SetAPen (rm.rastport_ptr, pen2);
  122.         gfx.Draw (rm.rastport_ptr, l + w - 1, t + h - 1);
  123.         gfx.Draw (rm.rastport_ptr, l, t + h - 1);
  124.         gfx.SetAPen (rm.rastport_ptr, pen1);
  125.         gfx.Draw (rm.rastport_ptr, l, t);
  126.         gfx.Move (rm.rastport_ptr, l + 1, t + 1);
  127.         gfx.SetAPen (rm.rastport_ptr, pen2);
  128.         gfx.Draw (rm.rastport_ptr, l + w - 2, t + 1);
  129.         gfx.SetAPen (rm.rastport_ptr, pen1);
  130.         gfx.Draw (rm.rastport_ptr, l + w - 2, t + h - 2);
  131.         gfx.Draw (rm.rastport_ptr, l + 1, t + h - 2);
  132.         gfx.SetAPen (rm.rastport_ptr, pen2);
  133.         gfx.Draw (rm.rastport_ptr, l + 1, t + 1);
  134.       ELSE
  135.         IF Recessed IN frm.flags THEN tag := gt.bbRecessed; data := TRUE
  136.         ELSE tag := u.ignore
  137.         END;
  138.         gt.DrawBevelBox ( rm.rastport_ptr,
  139.                           left, top, width, height,
  140.                           gt.visualInfo, frm.visInfo,
  141.                           tag,           data,
  142.                           u.done )
  143.       END
  144.     END;
  145.     (* return success *)
  146.     RETURN 0
  147.   END Render;
  148.  
  149. (*************************************************************************
  150. *                                                                        *
  151. * Constructors                                                           *
  152. *                                                                        *
  153. *************************************************************************)
  154.  
  155. PROCEDURE xNewFrame () : ea.OPTR;
  156.  
  157. <*$ ReturnChk- *>
  158. BEGIN (* xNewFrame *)
  159.   SYS.SETREG (0,
  160.       ea.NewObject ( ea.TYPE_CUSTOMIMAGE,
  161.           ea.BorderLeft,    0,
  162.           ea.BorderRight,   0,
  163.           ea.BorderTop,     0,
  164.           ea.BorderBottom,  0,
  165.           ea.RenderMethod,  RenderHook,
  166.           ea.UserData,      SYS.REG (8), (* frm *)
  167.           u.more,           SYS.REG (9), (* tags *)
  168.           u.done ))
  169. END xNewFrame;
  170.  
  171. PROCEDURE [4] NewFrame* ["EAFrames_xNewFrame"]
  172.   ( VAR frm [8] : Frame;
  173.     tags [9]..  : u.Tag )
  174.   : ea.OPTR;
  175.  
  176. PROCEDURE [4] NewFrameA* ["EAFrames_xNewFrame"]
  177.   ( VAR frm [8] : Frame;
  178.     tags [9]    : u.TagListPtr )
  179.   : ea.OPTR;
  180.  
  181. PROCEDURE InitFrame*
  182.   ( VAR frm  : Frame;
  183.     flags    : s.SET32;
  184.     visInfo  : gt.VisualInfo;
  185.     drawInfo : i.DrawInfoPtr );
  186.  
  187. BEGIN (* InitFrame *)
  188.   frm.flags := flags;
  189.   IF drawInfo # NIL THEN
  190.     frm.shinePen := SHORT (drawInfo.pens [i.shinePen]);
  191.     frm.shadowPen := SHORT (drawInfo.pens [i.shadowPen]);
  192.   ELSE
  193.     frm.shinePen := 2; frm.shadowPen := 1
  194.   END;
  195.   frm.visInfo := visInfo
  196. END InitFrame;
  197.  
  198.  
  199. (************************************************************************)
  200.  
  201. <*$ LongVars- *>
  202.  
  203. PROCEDURE Init;
  204. BEGIN (* Init *)
  205.   RenderHook := SYS.ADR (rhook);
  206.   u.InitHook (RenderHook, SYS.VAL (u.HookFunc, Render));
  207. END Init;
  208.  
  209. BEGIN
  210.   Init
  211. END EAFrames.
  212.